Attribute VB_Name = "modResetError"
'***************************************************************
' (c) Copyright 2000 Matthew J. Curland
'
' This file is from the CD-ROM accompanying the book:
' Advanced Visual Basic 6: Power Techniques for Everyday Programs
'   Author: Matthew Curland
'   Published by: Addison-Wesley, July 2000
'   ISBN: 0-201-70712-8
'   http://www.PowerVB.com
'
' You are entitled to license free distribution of any application
'   that uses this file if you own a copy of the book, or if you
'   have obtained the file from a source approved by the author. You
'   may redistribute this file only with express written permission
'   of the author.
'
' This file depends on:
'   References:
'     VBoostTypes6.olb (VBoost Object Types (6.0))
'   Files:
'     None
'   Minimal VBoost conditionals:
'     None
'   Conditional Compilation Values:
'     None
'
' This file is discussed in Chapter 8.
'***************************************************************
Option Explicit

Private Type ResetErrorVTable
    VTable(2) As Long
End Type

Private m_VTable As ResetErrorVTable
Private m_pVTable As Long

Public Type ResetError
    pVTable As Long
    pThisObject As IUnknown
End Type

'If an error is raised from a VTable function, VB will
'call QueryInterface for ISupportErrorInfo. If this QI
'fails, which is common with lightweight objects, then
'VB doesn't release the object until the next time an
'error is raised. This is harmless unless the project
'tears down before the error object is reset, which
'happens if the error raised by the lightweight object
'was the last before the project terminated. To use
'this object, put a ResetError structure at module
'scope in a .bas module and initialize the structure
'once with InitResetError m_ErrReset. The rest is
'taken care of by this file.
Public Sub InitResetError(ResetError As ResetError)
Dim PrevCursor As Long
    If m_pVTable = 0 Then
        With m_VTable
            .VTable(0) = FuncAddr(AddressOf QueryInterface)
            .VTable(1) = FuncAddr(AddressOf AddRef)
            .VTable(2) = FuncAddr(AddressOf Release)
            m_pVTable = VarPtr(.VTable(0))
        End With
    End If
    
    With ResetError
        .pVTable = m_pVTable
        CopyMemory .pThisObject, VarPtr(.pVTable), 4
    End With
End Sub

Private Function QueryInterface(This As ResetError, riid As Long, pvObj As Long) As Long
    Debug.Assert False 'QI not expected
    pvObj = 0
    QueryInterface = E_NOINTERFACE
End Function
Private Function AddRef(This As ResetError) As Long
    Debug.Assert False 'No need to addref
End Function
Private Function Release(This As ResetError) As Long
    On Error Resume Next
    Err.Raise 5
    On Error GoTo 0
End Function
Private Function FuncAddr(ByVal pfn As Long) As Long
    FuncAddr = pfn
End Function

